home *** CD-ROM | disk | FTP | other *** search
Text File | 1992-07-11 | 33.8 KB | 1,090 lines |
- / OS/8 ENCODING PROGRAM
-
- / LAST EDIT: 08-JUL-1992 22:00:00 CJL
-
- / MUST BE ASSEMBLED WITH '/F' SWITCH SET.
-
- / PROGRAM TO ENCODE OS/8 FILES INTO "PRINTABLE" ASCII FORMAT ("ENCODE").
-
- / DISTRIBUTED BY CUCCA AS "K12ENC.PAL" AS PART OF THE CUCCA KERMIT-12 PACKAGE.
-
- / WRITTEN BY:
-
- / CHARLES LASNER (CJL)
- / CLA SYSTEMS
- / 72-55 METROPOLITAN AVENUE
- / MIDDLE VILLAGE, NEW YORK 11379-2107
- / (718) 894-6499
-
- / USAGE:
-
- / .RUN DEV ENCODE INVOKE PROGRAM
- / *OUTPUT<INPUT PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <CR>)
- / *OUTPUT<DEV:=NNNN/I **** SPECIAL IMAGE TRANSFER MODE **** INPUT IS RECORD
- / 0000-[NNNN-1] ON DEVICE DEV:. THE =NNNN VALUE MUST BE
- / STATED PRECISELY TO TRANSFER THE REQUISITE AMOUNT OF
- / THE DEVICE AS REQUIRED. THE VALUE IS GENERALLY THE
- / TOTAL LENGTH OF THE DEVICE, BUT COULD BE LESS AS
- / NECESSARY; LARGER VALUES WILL GENERALLY FAIL. THIS
- / MODE SHOULD ONLY BE USED TO EFFECT TRANSFER OF
- / COMPLETE DEVICE IMAGES WHERE THE NORMAL OS/8 FILE
- / STRUCTURE IS UNSUITABLE. IN THIS MODE, THE OS/8 FILE
- / (POSSIBLY PRESENT) ON THE DEVICE IS IGNORED. ****
- / NOTE **** THIS METHOD VIOLATES ALL OS/8 DEVICE
- / STRUCTURE AND IS MEANT FOR TRANSFER OF COMPLETE DEVICE
- / IMAGES ONLY; USE WITH CARE!
- / *OUTPUT<DEV:=NNNN/I/1 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR
- / IMAGE MODE EXCEPT ONLY THE FIRST HALF OF THE DATA IS
- / USED. THE DECODER MUST BE GIVEN THE EQUIVALENT
- / PARAMETERS TO TRANSFER THE FIRST HALF.
- / *OUTPUT<DEV:=NNNN/I/2 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR
- / IMAGE MODE EXCEPT ONLY THE SECOND HALF OF THE DATA IS
- / USED. NOTE THAT THERE MUST BE TWO FILES CREATED, ONE
- / USING /I/1 AND THE OTHER USING /I/2 TO COMPLETELY
- / TRANSFER A DEVICE IMAGE UNLESS /I IS USED ALONE!
- / *OUTPUT<INPUT$ PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <ESC>)
- / . PROGRAM EXITS NORMALLY
-
- / INPUT FILE ASSUMES .SV EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION. IF
- / IMAGE MODE IS USED, THERE IS NO INPUT FILE SPECIFICATION; ONLY A DEVICE IS
- / GIVEN ALONG WITH A LENGTH AND THE MANDATORY /I SWITCH.
-
- / PROGRAM EXIT IS THE NORMAL OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE
- / KEYBOARD DURING THE COMMAND, OR ENDING THE COMMAND INPUT LINE WITH AN <ESC>
- / CHARACTER.
- / THIS PROGRAM SUPPORTS A SUBSET OF THE ASCII FILE ENCODING SCHEME DEVELOPED BY
- / CHARLES LASNER AND FRANK DA CRUZ. THE SCHEME USED IS FIVE-BIT ENCODING WITH
- / COMPRESSION, (AS OPPOSED TO SIX-BIT WITHOUT COMPRESSION AS USED IN PRIOR
- / VERSIONS).
-
- / RESTRICTIONS:
-
- / A) NO SUPPORT FOR MULTIPLE DECODABLE FILES PER ENCODED FILE.
-
- / B) CREATES ENCODED PDP-8 60-BIT CHECKSUM AT END OF FILE.
-
- / C) CUSTOMIZED (REMARK) COMMANDS MUST BE SEPARATELY ADDED BY THE USER.
-
- / D) THE FILENAME IN THE (FILE ) AND (END ) COMMANDS WILL BE IDENTICAL TO
- / THE ACTUAL INVOKED INPUT FILE. THE USER MUST SEPARATELY MODIFY THESE
- / COMMANDS WHEN EXPORTING THE ENCODED FILE TO A SYSTEM WITH DIFFERENT
- / NAMING CONVENTIONS.
-
- / ERROR MESSAGES.
-
- / ERROR MESSAGES ARE ONE OF TWO VARIETIES: COMMAND DECODER MESSAGES AND USER
- / (PROGRAM-SIGNALLED) MESSAGES.
-
- / COMMAND DECODER MESSAGES ARE NON-FATAL AND MERELY REQUIRE RETYPING THE
- / COMMAND. ATTEMPTING TO USE MORE THAN ONE OUTPUT FILE WILL YIELD THE COMMAND
- / DECODER MESSAGE "TOO MANY FILES" AND CAUSE A REPEAT OF THE COMMAND DECODER
- / PROMPT REQUIRING USER INPUT. THE USER IS DIRECTED TO OTHER DOCUMENTATION OF
- / THE "SPECIAL" MODE OF THE COMMAND DECODER, AS THAT IS THE ONLY MODE USED BY
- / THIS UTILITY PROGRAM.
-
- / ANY USER MESSAGE PRINTED IS A FATAL ERROR MESSAGE CAUSED BY A PROBLEM BEYOND
- / THE SCOPE OF THE COMMAND DECODER. ALL USER MESSAGES ARE THE STANDARD OS/8
- / "USER" ERROR MESSAGES OF THE FORM: "USER ERROR X AT AAAAA", WHERE X IS THE
- / ERROR NUMBER AND AAAAA IS THE PROGRAM ADDRESS WHERE THE ERROR WAS DETECTED.
- / THE FOLLOWING USER ERRORS ARE DEFINED:
-
- / ERROR NUMBER PROBABLE CAUSE
-
- / 0 NO OUTPUT FILE.
-
- / 1 INPUT FILE ERROR (CAN'T FIND INPUT FILE) OR NO INPUT
- / FILE SPECIFIED OR TOO MANY INPUT FILES SPECIFIED.
- / 2 ILLEGAL OUTPUT FILE NAME (WILD CARDS NOT ALLOWED).
-
- / 3 NO OUTPUT FILE NAME (DEVICE ONLY IS NOT ALLOWED).
-
- / 4 ERROR WHILE FETCHING FILE HANDLER.
-
- / 5 ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE.
-
- / 6 OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE.
-
- / 7 ERROR WHILE CLOSING THE OUTPUT FILE.
-
- / 8 I/O ERROR WHILE ENCODING FILE DATA.
- / ASSEMBLY INSTRUCTIONS.
-
- / IT IS ASSUMED THE SOURCE FILE K12ENC.PAL HAS BEEN MOVED AND RENAMED TO
- / DSK:ENCODE.PA.
-
- / .PAL ENCODE<ENCODE/E/F ASSEMBLE SOURCE PROGRAM
- / .LOAD ENCODE LOAD THE BINARY FILE
- / .SAVE DEV ENCODE=2001 SAVE THE CORE-IMAGE FILE
- / DEFINITIONS.
-
- AIWCNT= 1404 /ADDITIONAL INFORMATION WORDS COUNT HERE
- AIWXR= 0017 /POINTER TO ADDITIONAL INFORMATION WORDS
- CLOSE= 4 /CLOSE OUTPUT FILE
- DATEXT= 7777 /DATE EXTENSION HERE
- DATWRD= 7666 /OS/8 DATE WORD
- DECODE= 5 /CALL COMMAND DECODER
- ENTER= 3 /ENTER TENTATIVE FILE
- EQUWRD= 7646 /EQUALS PARAMETER HERE IN TABLE FIELD
- FETCH= 1 /FETCH HANDLER
- IHNDBUF=7200 /INPUT HANDLER BUFFER
- INBUFFE=6200 /INPUT BUFFER
- INFILE= 7605 /INPUT FILE INFORMATION HERE
- LOOKUP= 2 /LOOKUP INPUT FILE
- NL0001= CLA IAC /LOAD AC WITH 0001
- NL0002= CLA CLL CML RTL /LOAD AC WITH 0002
- NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776
- NL7777= CLA CMA /LOAD AC WITH 7777
- OHNDBUF=6600 /OUTPUT HANDLER BUFFER
- OUTBUFF=5600 /OUTPUT BUFFER
- OUTFILE=7600 /OUTPUT FILE INFORMATION HERE
- PRGFLD= 00 /PROGRAM FIELD
- RESET= 13 /RESET SYSTEM TABLES
- REVISIO=1 /PROGRAM REVISION
- SBOOT= 7600 /MONITOR EXIT
- SWAL= 7643 /A-/L SWITCHES HERE IN TABLE FIELD
- SWY9= 7645 /Y-/9 SWITCHES HERE IN TABLE FIELD
- TBLFLD= 10 /COMMAND DECODER TABLE FIELD
- TERMWRD=7642 /TERMINATOR WORD
- USERROR=7 /USER SIGNALLED ERROR
- USR= 0200 /USR ENTRY POINT
- USRENT= 7700 /USR ENTRY POINT WHEN NON-RESIDENT
- USRFLD= 10 /USR FIELD
- USRIN= 10 /LOCK USR IN CORE
- VERSION=2 /PROGRAM VERSION
- WIDTH= 107-2 /69 DATA CHARACTERS PER LINE (TOTAL 71)
- WRITE= 4000 /I/O WRITE BIT
- *0 /START AT THE BEGINNING
-
- *10 /DEFINE AUTO-INDEX AREA
-
- XR1, .-. /AUTO-INDEX NUMBER 1
- XR2, .-. /AUTO-INDEX NUMBER 2
-
- *20 /GET PAST AUTO-INDEX AREA
-
- BUFPTR, .-. /OUTPUT BUFFER POINTER
- CCNT, .-. /CHECKSUM COUNTER
- CHKFLG, .-. /CHECKSUMMING ALLOWED FLAG
- CHKSUM, ZBLOCK 5 /CHECKSUM
- CMPCNT, .-. /MATCH COUNT FOR COMPRESSION
- DANGCNT,.-. /DANGER COUNT
- FDATE, .-. /FILE DATE
- FILLVAL,.-. /FILL VALUE FOR SPECIAL OUTPUT CHARACTERS
- IDNUMBE,.-. /INPUT DEVICE NUMBER
- IFNAME, ZBLOCK 4 /INPUT FILENAME
- IMSW, .-. /IMAGE-MODE SWITCH
- INLEN, .-. /INPUT FILE LENGTH
- INPTR, .-. /INPUT BUFFER POINTER
- INPUT, .-. /INPUT HANDLER POINTER
- INRECOR,.-. /INPUT RECORD
- FNAME, ZBLOCK 4 /OUTPUT FILENAME
- LATEST, .-. /LATEST OUTPUT CHARACTER
- OBOUND, .-. /OUTPUT BOUNDARY COUNTER
- OCTCNT, .-. /OCTAL OUTPUT ROUTINE COUNTER
- OCTEMP, .-. /OCTAL OUTPUT ROUTINE TEMPORARY
- ODNUMBE,.-. /OUTPUT DEVICE NUMBER
- OUTPUT, .-. /OUTPUT HANDLER POINTER
- OUTRECO,.-. /OUTPUT RECORD
- PRTEMP, .-. /DATE OUTPUT TEMPORARY
- PUTEMP, .-. /OUTPUT TEMPORARY
- PUTLATE,.-. /LATEST 5-BIT CHARACTER
- PUTPREV,.-. /PREVIOUS OUTPUT TEMPORARY
- QUO, .-. /DIVIDE QUOTIENT
- REM, .-. /DIVIDE REMAINDER
- SCRCASE,.-. /CURRENT MESSAGE CASE
- SCRCHAR,.-. /LATEST MESSAGE CHARACTER
- SCRPTR, .-. /MESSAGE POINTER
- TDATE, .-. /TODAY'S DATE
- TEMP, .-. /TEMPORARY
- TEMPTR, .-. /TEMPORARY OUTPUT POINTER
- WIDCNT, .-. /LINE WIDTH COUNTER
- PAGE /START AT THE USUAL PLACE
-
- BEGIN, NOP /IN CASE WE'RE CHAINED TO
- CLA /CLEAN UP
- START, CIF USRFLD /GOTO USR FIELD
- JMS I (USRENTRY) /CALL USR ROUTINE
- USRIN /GET IT LOCKED IN
- CIF USRFLD /GOTO USR FIELD
- JMS I [USR] /CALL USR ROUTINE
- DECODE /WANT COMMAND DECODER
- "*^100 /USING SPECIAL MODE
- CDF TBLFLD /GOTO TABLE FIELD
- TAD I (TERMWRD) /GET TERMINATOR WORD
- SPA CLA /SKIP IF <CR> TERMINATED THE LINE
- DCA EXITZAP /ELSE CAUSE EXIT LATER
- DCA IMSW /CLEAR IMAGE-MODE; MIGHT GET SET LATER THOUGH
- TAD I (OUTFILE) /GET OUTPUT FILE DEVICE WORD
- SNA /SKIP IF OUTPUT FILE PRESENT
- JMP TSTMORE /JUMP IF NOT THERE
- AND [17] /JUST DEVICE BITS
- DCA ODNUMBER /SAVE OUTPUT DEVICE NUMBER
- TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD
- SNA /SKIP IF PRESENT
- JMP INERR /JUMP IF NOT
- AND [17] /JUST DEVICE BITS
- DCA IDNUMBER /SAVE INPUT DEVICE NUMBER
- TAD I (INFILE+5) /GET SECOND INPUT FILE DEVICE WORD
- SZA CLA /SKIP IF ONLY ONE INPUT FILE
- JMP INERR /ELSE COMPLAIN
- JMS I (MIFNAME) /MOVE INPUT FILENAME WITH ADJUSTED EXTENSION
- TAD I [OUTFILE+1] /GET FIRST OUTPUT FILENAME WORD
- SNA CLA /SKIP IF NAME PRESENT
- JMP NONAMERROR /JUMP IF DEVICE ONLY
- JMS I (MOFNAME) /MOVE OUTPUT FILENAME
- CDF PRGFLD /BACK TO OUR FIELD
- CIF USRFLD /GOTO USR FIELD
- JMS I [USR] /CALL USR ROUTINE
- RESET /RESET SYSTEM TABLES
- TAD (OHNDBUFFER+1) /GET BUFFER POINTER+TWO-PAGE BIT
- DCA OHPTR /STORE IN-LINE
- TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
- CIF USRFLD /GOTO USR FIELD
- JMS I [USR] /CALL USR ROUTINE
- FETCH /FETCH HANDLER
- OHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT
- JMP FERROR /FETCH ERROR
- TAD OHPTR /GET RETURNED ADDRESS
- DCA OUTPUT /STORE AS OUTPUT HANDLER ADDRESS
- TAD (IHNDBUFFER+1) /GET INPUT BUFFER POINTER+TWO-PAGE BIT
- DCA IHPTR /STORE IN-LINE
- TAD IDNUMBER /GET INPUT DEVICE NUMBER
- CIF USRFLD /GOTO USR FIELD
- JMS I [USR] /CALL USR ROUTINE
- FETCH /FETCH HANDLER
- IHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT
- JMP FERROR /FETCH ERROR
- TAD IHPTR /GET RETURNED ADDRESS
- DCA INPUT /STORE AS INPUT HANDLER ADDRESS
- TAD IMSW /GET IMAGE-MODE SWITCH
- SNA CLA /SKIP IF IMAGE MODE SET
- JMS I (GEIFILE) /GO LOOKUP INPUT FILE
- TAD (FNAME) /POINT TO
- DCA ENTAR1 /STORED FILENAME
- DCA ENTAR2 /CLEAR SECOND ARGUMENT
- JMS I (INDATE) /GET INPUT FILE'S DATE
- TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
- CIF USRFLD /GOTO USR FIELD
- JMS I [USR] /CALL USR ROUTINE
- ENTER /ENTER TENTATIVE FILENAME
- ENTAR1, .-. /WILL POINT TO FILENAME
- ENTAR2, .-. /WILL BE ZERO
- JMP ENTERR /ENTER ERROR
- TAD ENTAR1 /GET RETURNED FIRST RECORD
- DCA OUTRECORD /STORE IT
- TAD ENTAR2 /GET RETURNED EMPTY LENGTH
- IAC /ADD 2-1 FOR OS/278 CRAZINESS
- DCA DANGCNT /STORE AS DANGER COUNT
- JMS I (CLRCHKSUM) /CLEAR THE CHECKSUM
- JMS I (ENCODIT) /GO DO THE ACTUAL ENCODING
- JMP PROCERR /ERROR WHILE ENCODING
- TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
- CIF USRFLD /GOTO USR FIELD
- JMS I [USR] /CALL USR ROUTINE
- CLOSE /CLOSE OUTPUT FILE
- FNAME /POINTER TO FILENAME
- OUTCNT, .-. /WILL BE ACTUAL COUNT
- JMP CLSERR /CLOSE ERROR
- EXITZAP,JMP START /**** <ESC> TERMINATION **** 0000
- JMP I (SBOOT) /EXIT TO MONITOR
- / ERROR WHILE PROCESSING INPUT FILE.
-
- PROCERR,NL0002 /SET INCREMENT
- SKP /DON'T USE NEXT
-
- / ERROR WHILE CLOSING THE OUTPUT FILE.
-
- CLSERR, NL0001 /SET INCREMENT
- SKP /DON'T CLEAR IT
-
- / OUTPUT FILE TOO LARGE ERROR.
-
- SIZERR, CLA /CLEAN UP
- TAD [3] /SET INCREMENT
- SKP /DON'T USE NEXT
-
- / ENTER ERROR.
-
- ENTERR, NL0002 /SET INCREMENT
- SKP /DON'T USE NEXT
-
- / HANDLER FETCH ERROR.
-
- FERROR, NL0001 /SET INCREMENT
-
- / NO OUTPUT FILENAME ERROR.
-
- NONAMER,IAC /SET INCREMENT
-
- / ILLEGAL OUTPUT FILE NAME ERROR.
-
- BADNAME,IAC /SET INCREMENT
-
- / INPUT FILESPEC ERROR.
-
- INERR, IAC /SET INCREMENT
-
- / OUTPUT FILESPEC ERROR.
-
- OUTERR, DCA ERRNUMBER /STORE ERROR NUMBER
- CDF PRGFLD /ENSURE OUR FIELD
- CIF USRFLD /GOTO USR FIELD
- JMS I [USR] /CALL USR ROUTINE
- USERROR /USER ERROR
- ERRNUMB,.-. /WILL BE PASSED ERROR NUMBER
-
- / COMES HERE TO TEST FOR NULL LINE.
-
- TSTMORE,TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD
- SZA CLA /SKIP NO INPUT OR OUTPUT GIVEN
- JMP OUTERR /ELSE COMPLAIN
- CDF PRGFLD /BACK TO OUR FIELD
- JMP EXITZAP /MIGHT BE LAST TIME, SO GO THERE FIRST
- PAGE
- ENCODIT,.-. /ENCODING ROUTINE
- TAD INRECORD /GET INPUT FILE STARTING RECORD
- DCA INREC /STORE IN-LINE
- NL7777 /SETUP INITIALIZE VALUE
- JMS I [DOBYTE] /INITIALIZE OUTPUT ROUTINE
- JMS I (TDMESSAGE) /OUTPUT TODAY'S DATE MESSAGE
- JMS I (FDMESSAGE) /OUTPUT FILE DATE MESSAGE
- JMS I [SCRIBE] /OUTPUT THE
- FILMSG /(FILE MESSAGE
- JMS I (PIFNAME) /OUTPUT THE INPUT FILENAME
- JMS I [SCRIBE] /OUTPUT THE
- EMSG /LINE ENDING
- TAD [-WIDTH] /SETUP THE
- DCA WIDCNT /LINE WIDTH COUNTER
- JMS I (OUTSETUP) /SETUP PACKING ROUTINE AND CLEAR FILL
- TAD [-5] /INITIALIZE
- DCA OBOUND /BOUNDARY COUNTER
- ENCLOOP,JMS I INPUT /CALL INPUT HANDLER
- 2^100 /READ TWO PAGES
- PINBUFF,INBUFFER /INTO INPUT BUFFER
- INREC, .-. /WILL BE LATEST INPUT FILE RECORD
- ENCERRO,JMP I ENCODIT /INPUT ERROR, TAKE IMMEDIATE RETURN
- ISZ INREC /BUMP TO NEXT RECORD
- NOP /JUST IN CASE
- TAD PINBUFFER/(INBUFFER) /SETUP THE
- DCA INPTR /BUFFER POINTER
- LOOP, JMS I (CHKBND) /CHECK IF ON A GOOD BOUNDARY
- JMP NOCOMPRESSION /COMPRESS IS NOT ALLOWED AT THIS TIME
- TAD INPTR /GET CURRENT POINTER
- DCA XR1 /STASH FOR SEARCH
- DCA CMPCNT /CLEAR MATCH COUNT
- CMPLUP, TAD XR1 /GET INDEX VALUE
- TAD (-2^200-INBUFFER+1) /COMPARE TO LIMIT
- SNA CLA /SKIP IF NOT AT END OF BUFFER
- JMP CMPEND /JUMP IF AT END OF BUFFER
- TAD I XR1 /GET A CANDIDATE WORD
- CIA /INVERT FOR TEST
- TAD I INPTR /COMPARE TO CURRENT TEST VALUE
- SZA CLA /SKIP IF IT MATCHES
- JMP CMPEND /JUMP IF THIS IS NOT A REPEAT
- ISZ CMPCNT /BUMP MATCH COUNT
- JMP CMPLUP /TRY TO FIND MORE
- / COMES HERE POSSIBLY WITH SOME COMPRESSED VALUES COUNTED.
-
- CMPEND, NL7776 /-2
- TAD CMPCNT /DID WE FIND ENOUGH MATCHES?
- SPA CLA /SKIP IF SO
- JMP NOCOMPRESSION /FORGET IT
- TAD ("X-"0) /SETUP COMPRESSION INDICATOR
- JMS I (OUTSETUP) /SETUP SPECIAL MODE
- JMS I (PUT5) /OUTPUT "X"
- JMS I (OUTSETUP) /SETUP NORMAL NUMERICAL MODE
- TAD I INPTR /GET THE VALUE
- JMS I [PUTIT] /OUTPUT IT
- ISZ CMPCNT /ACCOUNT FOR ORIGINAL
- TAD CMPCNT /GET COMPRESSION COUNT
- CLL RTL;RTL /*16
- JMS I [PUTIT] /OUTPUT BITS[0-7] ONLY
- JMS I (OUTSETUP) /SETUP NORMAL NUMERICAL MODE AGAIN
- TAD INPTR /GET INPUT POINTER
- TAD CMPCNT /UPDATE PAST ALL COMPRESSED VALUES
- DCA INPTR /STORE BACK
- JMP TEST /CONTINUE THERE
-
- / COMES HERE IF NO COMPRESSION FOUND (OR NOT ALLOWED).
-
- NOCOMPR,TAD I INPTR /GET LATEST VALUE
- JMS I [PUTIT] /OUTPUT IT
- ISZ INPTR /BUMP TO NEXT
- ISZ OBOUND /BUMP TO NEXT WORD
- JMP TEST /KEEP GOING
- TAD [-5] /RESET THE
- DCA OBOUND /BOUNDARY COUNTER
- TEST, TAD INPTR /GET INPUT POINTER
- TAD (-2^200-INBUFFER) /COMPARE TO UPPER LIMIT
- SZA CLA /SKIP IF AT END OF BUFFER
- JMP LOOP /ELSE JUST KEEP GOING
- ISZ INLEN /DONE ALL INPUT RECORDS?
- JMP ENCLOOP /NO, KEEP GOING
-
- / WE MUST FINISH THE LAST [5 WORDS => 12 BYTES] SEQUENCE.
-
- ENDLUP, JMS I (CHKBND) /AT A GOOD BOUNDARY?
- SKP /SKIP IF NOT
- JMP ENDONE /JUMP IF SO
- JMS I [PUTIT] /OUTPUT SOME WASTE BYTES
- ISZ OBOUND /AT A GOOD BOUNDARY NOW?
- JMP ENDLUP /NO, TRY AGAIN
- ENDONE, TAD ("Z-"0) /GET END INDICATOR
- JMS I (OUTSETUP) /SETUP SPECIAL MODE
- JMS I (PUT5) /OUTPUT A "Z"
- JMS I (INVCHKSUM) /INVERT THE CHECKSUM
- JMS I (OUTSETUP) /SETUP NORMAL NUMERICAL MODE
- JMS I (CHKOUT) /OUTPUT THE CHECKSUM
- JMS I [SCRIBE] /OUTPUT THE
- ENDMSG /END MESSAGE
- JMS I (PIFNAME) /OUTPUT THE INPUT FILENAME
- JMS I [SCRIBE] /OUTPUT THE
- EMSG /LINE ENDING
- JMS I [SCRIBE] /OUTPUT THE
- EOFMSG /FINAL MESSAGE
- TAD ("Z&37) /GET <^Z>
- CLOSLUP,JMS I [DOBYTE] /OUTPUT A BYTE (^Z OR NULL)
- TAD BUFPTR /GET THE OUTPUT BUFFER POINTER
- TAD (-OUTBUFFER) /COMPARE TO RESET VALUE
- SZA CLA /SKIP IF IT MATCHES
- JMP CLOSLUP /ELSE KEEP GOING
- ISZ ENCODIT /NO ERRORS
- JMP I ENCODIT /RETURN
-
- PAGE
- PUTIT, .-. /WORD OUTPUT ROUTINE
- DCA PUTEMP /SAVE PASSED VALUE
- JMS I (CALCHKSUM) /UPDATE CHECKSUM
- JMP I PUTNXT /GO WHERE YOU SHOULD GO
-
- PUTNXT, PUT0 /OUTPUT EXIT ROUTINE
- TAD PUTEMP /GET LATEST VALUE
- DCA PUTPREV /SAVE FOR NEXT TIME
- JMP I PUTIT /RETURN TO MAIL CALLER
-
- PUTLUP, JMS PUTNXT /GET ANOTHER WORD
- PUT0, TAD PUTEMP /GET WORD[0]
- RTL;RTL;RTL /BITS[0-4] => AC[7-11]
- JMS PUT5 /OUTPUT A CHARACTER
- TAD PUTEMP /GET WORD[0] AGAIN
- RTR /BITS[5-9] => AC[7-11]
- JMS PUT5 /OUTPUT A CHARACTER
- JMS PUTNXT /GET ANOTHER WORD
- PUT1, TAD PUTPREV /GET WORD[0]
- AND [3] /ISOLATE BITS[10-11]
- CLL RTL;RAL /BITS[10-11] => AC[7-8]
- DCA PUTPREV /SAVE FOR NOW
- TAD PUTEMP /GET WORD[1]
- RTL;RTL /BITS[0-2] => AC[9-11]
- AND [7] /ISOLATE DESIRED BITS
- TAD PUTPREV /ADD ON WORD[0] BITS IN AC[7-8]
- JMS PUT5 /OUTPUT A CHARACTER
- TAD PUTEMP /GET WORD[1]
- RTR;RTR /BITS[3-7] => AC[7-11]
- JMS PUT5 /OUTPUT A CHARACTER
- JMS PUTNXT /GET ANOTHER WORD
- PUT2, TAD PUTEMP /GET WORD[2]
- RAL /BIT[0] => L
- CLA /CLEAN UP
- TAD PUTPREV /GET WORD[1]
- RAL /BITS[8-11],L => AC[7-11]
- JMS PUT5 /OUTPUT A CHARACTER
- TAD PUTEMP /GET WORD[2]
- RTR;RTR;RTR /BITS[1-5] => AC[7-11]
- JMS PUT5 /OUTPUT A CHARACTER
- TAD PUTEMP /GET WORD[2]
- RAR /BITS[6-10] => AC[7-11]
- JMS PUT5 /OUTPUT A CHARACTER
- JMS PUTNXT /GET ANOTHER WORD
- PUT3, TAD PUTPREV /GET WORD[2]
- RAR /BIT[11] => L
- CLA /CLEAN UP
- TAD PUTEMP /GET WORD[3]
- RTL;RTL;RAL /L, BITS[0-3] => AC[7-11]
- JMS PUT5 /OUTPUT A CHARACTER
- TAD PUTEMP /GET WORD[3]
- RTR;RAR /BITS[4-8] => AC[7-11]
- JMS PUT5 /OUTPUT A CHARACTER
- JMS PUTNXT /GET ANOTHER WORD
- PUT4, TAD PUTPREV /GET WORD[3]
- AND [7] /ISOLATE BITS[9-11]
- CLL RTL /BITS[9-11] => AC[7-9]
- DCA PUTPREV /SAVE FOR NOW
- TAD PUTEMP /GET WORD[4]
- RTL;RAL /BITS[0-1] => AC[10-11]
- AND [3] /ISOLATE BITS[10-11]
- TAD PUTPREV /ADD ON WORD[3] BITS IN AC[7-9]
- JMS PUT5 /OUTPUT A CHARACTER
- TAD PUTEMP /GET WORD[4]
- RTR;RTR;RAR /BITS[2-6] => AC[7-11]
- JMS PUT5 /OUTPUT A CHARACTER
- TAD PUTEMP /GET WORD[4] BITS[7-11] IN AC[7-11]
- JMS PUT5 /OUTPUT A CHARACTER
- JMP PUTLUP /GO DO ANOTHER GROUP OF FIVE WORDS
-
- CHKNL, .-. /CHECK IF AT NEW LINE ROUTINE
- TAD WIDCNT /GET LINE WIDTH COUNTER
- TAD (WIDTH) /COMPARE TO MAXIMIM VALUE
- SZA CLA /SKIP IF AT MAXIMUM
- ISZ CHKNL /TAKE SKIP RETURN IF NOT AT MAXIMUM
- JMP I CHKNL /RETURN EITHER WAY
-
- OUTSETU,.-. /OUTPUT SETUP ROUTINE
- DCA FILLVALUE /STORE PASSED FILL VALUE
- TAD (PUT0) /SETUP THE
- DCA PUTNXT /OUTPUT CO-ROUTINE
- JMP I OUTSETUP /RETURN
- PUT5, .-. /FIVE-BIT OUTPUT ROUTINE
- AND [37] /JUST 5 BITS
- DCA PUTLATEST /SAVE IT
- JMS CHKNL /CHECK IF AT BEGINNING OF LINE
- SKP /SKIP IF NOT
- JMP PUTNORMAL /JUMP IF SO
- TAD ("<&177) /GET BEGINNING BRACKET
- JMS I [DOBYTE] /OUTPUT IT
- PUTNORM,TAD PUTLATEST /GET LATEST VALUE
- TAD ("0-"9-1) /COMPARE TO FIRST LIMIT
- SMA CLA /SKIP IF LESS
- TAD ["A-"9-1] /CONVERT LARGER VALUES TO A-V
- TAD PUTLATEST /ADD ON LATEST VALUE
- TAD ["0&177] /MAKE IT ASCII
- TAD FILLVALUE /ADD ON FILL VALUE FOR SPECIAL MODE
- JMS I [DOBYTE] /OUTPUT IT
- ISZ WIDCNT /BUMP LINE COUNTER
- TAD WIDCNT /GET LINE COUNTER
- SZA CLA /SKIP IF AT END OF LINE
- JMP I PUT5 /ELSE JUST RETURN
- TAD (">&177) /GET DATA CLOSING CHARACTER
- JMS I [DOBYTE] /OUTPUT IT
- TAD ["M&37] /GET A <CR>
- JMS I [DOBYTE] /OUTPUT IT
- TAD ["J&37] /GET A <LF>
- JMS I [DOBYTE] /OUTPUT IT
- TAD [-WIDTH] /RESET THE
- DCA WIDCNT /LINE WIDTH COUNTER
- JMP I PUT5 /RETURN
-
- PAGE
- / MESSAGE PRINT ROUTINE.
-
- SCRIBE, .-. /MESSAGE PRINT ROUTINE
- TAD I SCRIBE /GET IN-LINE POINTER ARGUMENT
- DCA SCRPTR /STASH THE POINTER
- ISZ SCRIBE /BUMP PAST ARGUMENT
- TAD (140) /INITIALIZE TO
- DCA SCRCASE /LOWER-CASE
- SCRLUP, TAD I SCRPTR /GET LEFT HALF-WORD
- RTR;RTR;RTR /MOVE OVER
- JMS SCRPRNT /PRINT IT
- TAD I SCRPTR /GET RIGHT HALF-WORD
- JMS SCRPRNT /PRINT IT
- ISZ SCRPTR /BUMP TO NEXT PAIR
- JMP SCRLUP /KEEP GOING
-
- SCRPRNT,.-. /CHARACTER PRINT ROUTINE
- AND [77] /JUST SIX BITS
- SNA /END OF MESSAGE?
- JMP I SCRIBE /YES, RETURN TO ORIGINAL CALLER
- DCA SCRCHAR /NO, SAVE FOR NOW
- TAD SCRCHAR /GET IT BACK
- TAD (-"%!200) /IS IT "%"?
- SNA /SKIP IF NOT
- JMP SCRCRLF /JUMP IF IT MATCHES
- TAD (-"^+100+"%) /IS IT "^"
- SNA CLA /SKIP IF NOT
- JMP SCRFLIP /JUMP IF IT MATCHES
- TAD SCRCHAR /GET THE CHARACTER
- AND [40] /DOES CASE MATTER?
- SNA CLA /SKIP IF NOT
- TAD SCRCASE /ELSE GET PREVAILING CASE
- TAD SCRCHAR /GET THE CHARACTER
- SCRPRLF,JMS I [DOBYTE] /OUTPUT THE CHARACTER
- JMP I SCRPRNT /RETURN
-
- SCRCRLF,TAD ["M&37] /GET A <CR>
- JMS I [DOBYTE] /OUTPUT IT
- TAD ["J&37] /GET A <LF>
- JMP SCRPRLF /CONTINUE THERE
-
- SCRFLIP,TAD SCRCASE /GET CURRENT CASE
- CIA /INVERT IT
- TAD (140+100) /ADD SUM OF POSSIBLE VALUES
- DCA SCRCASE /STORE NEW INVERTED CASE
- JMP I SCRPRNT /RETURN
- PUTBYTE,.-. /OUTPUT A BYTE ROUTINE
- SPA /ARE WE INITIALIZING?
- JMP PUTINITIALIZE /YES
- AND (177) /JUST IN CASE
- DCA LATEST /SAVE LATEST CHARACTER
- TAD LATEST /GET LATEST CHARACTER
- JMP I PUTNEXT /GO WHERE YOU SHOULD GO
-
- PUTNEXT,.-. /EXIT ROUTINE
- ISZ PUTBYTE /BUMP TO GOOD RETURN
- PUTERRO,CLA CLL /CLEAN UP
- JMP I PUTBYTE /RETURN TO MAIN CALLER
-
- PUTINIT,CLA /CLEAN UP
- TAD OUTRECORD /GET STARTING RECORD OF TENTATIVE FILE
- DCA PUTRECORD /STORE IN-LINE
- DCA I (OUTCNT) /CLEAR ACTUAL FILE LENGTH
- PUTNEWR,TAD (OUTBUFFER) /SETUP THE
- DCA BUFPTR /BUFFER POINTER
- PUTLOOP,JMS PUTNEXT /GET A CHARACTER
- DCA I BUFPTR /STORE IT
- TAD BUFPTR /GET POINTER VALUE
- DCA TEMPTR /SAVE FOR LATER
- ISZ BUFPTR /BUMP TO NEXT
- JMS PUTNEXT /GET A CHARACTER
- DCA I BUFPTR /STORE IT
- JMS PUTNEXT /GET A CHARACTER
- RTL;RTL /MOVE UP
- AND [7400] /ISOLATE HIGH NYBBLE
- TAD I TEMPTR /ADD ON FIRST BYTE
- DCA I TEMPTR /STORE COMPOSITE
- TAD LATEST /GET LATEST CHARACTER
- RTR;RTR;RAR /MOVE UP AND
- AND [7400] /ISOLATE LOW NYBBLE
- TAD I BUFPTR /ADD ON SECOND BYTE
- DCA I BUFPTR /STORE COMPOSITE
- ISZ BUFPTR /BUMP TO NEXT
- TAD BUFPTR /GET LATEST POINTER VALUE
- TAD (-2^200-OUTBUFFERR) /COMPARE TO LIMIT
- SZA CLA /SKIP IF AT END
- JMP PUTLOOP /KEEP GOING
- ISZ DANGCNT /TOO MANY RECORDS?
- SKP /SKIP IF NOT
- JMP I (SIZERR) /JUMP IF SO
- JMS I OUTPUT /CALL I/O HANDLER
- 2^100+WRITE /WRITE SOME PAGES FROM OUTPUT BUFFER
- OUTBUFFER /BUFFER ADDRESS
- PUTRECO,.-. /WILL BE LATEST RECORD NUMBER
- JMP PUTERROR /OUTPUT ERROR!
- ISZ I (OUTCNT) /BUMP ACTUAL LENGTH
- ISZ PUTRECORD /BUMP TO NEXT RECORD
- JMP PUTNEWRECORD /KEEP GOING
- DOBYTE, .-. /OUTPUT A BYTE ROUTINE
- JMS PUTBYTE /OUTPUT PASSED VALUE
- JMP I (ENCERROR) /COULDN'T DO IT
- JMP I DOBYTE /RETURN
-
- PAGE
- / INPUT FILE ROUTINE.
-
- GEIFILE,.-. /GET INPUT FILE ROUTINE
- JMS LUKUP /TRY TO LOOKUP THE FILE
- SKP /SKIP IF IT WORKED
- JMP TRYNULL /TRY NULL EXTENSION VERSION
- NULLOK, TAD LARG2 /GET NEGATED LENGTH
- DCA INLEN /STASH IT
- TAD LARG1 /GET FIRST INPUT RECORD
- DCA INRECORD /STASH IT
- JMP I GEIFILE /RETURN
-
- / COMES HERE IF LOOKUP FAILED.
-
- TRYNULL,CDF TBLFLD /GOTO TABLE FIELD
- TAD I [INFILE+4] /GET ORIGINAL FILENAME'S EXTENSION
- CDF PRGFLD /BACK TO OUR FIELD
- SZA CLA /SKIP IF IT WAS NULL ORIGINALLY
- JMP I (INERR) /ELSE COMPLAIN OF EXPLICIT LOOKUP FAILURE
- DCA IFNAME+3 /NOW TRY NULL VERSION INSTEAD OF DEFAULT VERSION
- JMS LUKUP /TRY TO LOOK IT UP AGAIN
- JMP NULLOK /THAT WORKED!
- JMP I (INERR) /COMPLAIN OF LOOKUP FAILURE
-
- LUKUP, .-. /LOW-LEVEL LOOKUP ROUTINE
- TAD (IFNAME) /GET OUR FILENAME POINTER
- DCA LARG1 /STORE IN-LINE
- DCA LARG2 /CLEAR SECOND ARGUMENT
- TAD IDNUMBER /GET INPUT DEVICE NUMBER
- CIF USRFLD /GOTO USR FIELD
- JMS I [USR] /CALL USR ROUTINE
- LOOKUP /WANT LOOKUP FUNCTION
- LARG1, .-. /WILL BE POINTER TO OUR FILENAME
- LARG2, .-. /WILL RETURN FILE LENGTH (HOPEFULLY)
- ISZ LUKUP /LOOKUP FAILED, SO BUMP RETURN ADDRESS
- JMP I LUKUP /RETURN EITHER WAY
- / INPUT FILENAME PRINT ROUTINE.
-
- PIFNAME,.-. /PRINT INPUT FILENAME ROUTINE
- TAD IMSW /GET IMAGE-MODE SWITCH
- SNA CLA /SKIP IF SET
- JMP DOIFNAME /JUMP IF NOT
- JMS I [SCRIBE] /OUTPUT THE
- IFMSG /IMAGE MESSAGE
- CDF TBLFLD /GOTO TABLE FIELD
- TAD I [EQUWRD] /GET EQUALS PARAMETER
- CDF PRGFLD /BACK TO OUR FIELD
- JMS I (OCTOUT) /OUTPUT IT
- CDF TBLFLD /GOTO TABLE FIELD
- TAD I [SWY9] /GET /Y-/9 SWITCHES
- CDF PRGFLD /BACK TO OUR FIELD
- AND [600] /JUST /1, /2 BITS
- SNA /SKIP IF SOMETHING SET
- JMP I PIFNAME /JUST RETURN IF NOT
- AND [400] /JUST /1 BIT
- SNA CLA /SKIP IF /1 SET
- JMP PIFPT2 /JUMP IF /2 SET
- JMS I [SCRIBE] /OUTPUT THE
- PT1MSG /PART ONE MESSAGE
- JMP I PIFNAME /RETURN
-
- PIFPT2, JMS I [SCRIBE] /OUTPUT THE
- PT2MSG /PART TWO MESSAGE
- JMP I PIFNAME /RETURN
-
- DOIFNAM,TAD IFNAME /GET FIRST PAIR
- JMS PIF2 /PRINT IT
- TAD IFNAME+1 /GET SECOND PAIR
- JMS PIF2 /PRINT IT
- TAD IFNAME+2 /GET THIRD PAIR
- JMS PIF2 /PRINT IT
- TAD (".&177) /GET SEPARATOR
- JMS PIFOUT /PRINT IT
- TAD IFNAME+3 /GET FOURTH PAIR
- JMS PIF2 /PRINT IT
- JMP I PIFNAME /RETURN
-
- PIF2, .-. /PRINT A PAIR ROUTINE
- DCA SCRCHAR /SAVE PASSED PAIR
- TAD SCRCHAR /GET IT BACK
- RTR;RTR;RTR /MOVE DOWN
- JMS PIFOUT /PRINT HIGH-ORDER FIRST
- TAD SCRCHAR /GET IT AGAIN
- JMS PIFOUT /PRINT LOW-ORDER
- JMP I PIF2 /RETURN
- PIFOUT, .-. /FILENAME CHARACTER OUTPUT ROUTINE
- AND [77] /JUST SIXBIT
- SNA /SKIP IF SOMETHING THERE
- JMP I PIFOUT /ELSE IGNORE IT
- TAD [40] /INVERT IT
- AND [77] /REMOVE EXCESS
- TAD [40] /INVERT IT AGAIN
- JMS I [DOBYTE] /OUTPUT IT
- JMP I PIFOUT /RETURN
-
- MOFNAME,.-. /MOVE OUTPUT FILENAME ROUTINE
- TAD I [OUTFILE+1] /GET FIRST OUTPUT FILENAME WORD
- JMS CHKNAME /CHECK IF LEGAL
- DCA FNAME /STASH IT
- TAD I (OUTFILE+2) /GET SECOND OUTPUT FILENAME WORD
- JMS CHKNAME /CHECK IF LEGAL
- DCA FNAME+1 /STASH IT
- TAD I (OUTFILE+3) /GET THIRD OUTPUT FILENAME WORD
- JMS CHKNAME /CHECK IF LEGAL
- DCA FNAME+2 /STASH IT
- TAD I (OUTFILE+4) /GET FOURTH OUTPUT FILENAME WORD
- JMS CHKNAME /CHECK IF LEGAL
- DCA FNAME+3 /STASH IT
- JMP I MOFNAME /RETURN
-
- / OUTPUT NAME CHECK ROUTINE.
-
- CHKNAME,.-. /OUTPUT NAME CHECK ROUTINE
- DCA LUKUP /SAVE PASSED VALUE
- TAD LUKUP /GET IT BACK
- RTR;RTR;RTR /MOVE DOWN
- JMS CHKIT /CHECK HIGH-ORDER AND GET IT BACK
- JMS CHKIT /CHECK LOW-ORDER AND GET IT BACK
- JMP I CHKNAME /RETURN
-
- CHKIT, .-. /ONE CHARACTER CHECK ROUTINE
- AND [77] /JUST SIX BITS
- TAD (-"?!200) /COMPARE TO "?"
- SZA /SKIP IF ALREADY BAD
- TAD (-"*+"?) /ELSE COMPARE TO "*"
- SNA CLA /SKIP IF NEITHER BAD CASE
- JMP I (BADNAME) /COMPLAIN OF WILD CHARACTER
- TAD LUKUP /GET THE PAIR BACK FOR NEXT TIME
- JMP I CHKIT /RETURN
- PAGE
- CALCHKS,.-. /CALCULATE CHECKSUM ROUTINE
- TAD CHKFLG /SHOULD WE CHECKSUM?
- SZA CLA /SKIP IF SO
- JMP I CALCHKSUM /JUMP IF NOT
- JMS CHKSETUP /SETUP
- TAD PUTEMP /GET PASSED VALUE
- CLL RAR /CLEAR LINK AND MOVE OVER
- ADDLUP, RAL /MOVE OVER CARRY
- TAD I XR1 /ADD A WORD
- DCA I XR2 /STORE BACK
- ISZ CCNT /DONE ENOUGH?
- JMP ADDLUP /NO, KEEP GOING
- JMP I CALCHKSUM /YES, RETURN
-
- CHKOUT, .-. /OUTPUT THE CHECKSUM ROUTINE
- JMS CHKSETUP /SETUP
- ISZ CHKFLG /DISABLE CHECKSUMMING
- TAD I XR1 /GET A WORD
- JMS I [PUTIT] /OUTPUT IT
- ISZ CCNT /DONE YET?
- JMP .-3 /NO, KEEP GOING
- JMP I CHKOUT /YES, WE'RE DONE
-
- CLRCHKS,.-. /CLEAR CHECKSUM ROUTINE
- JMS CHKSETUP /SETUP
- DCA I XR1 /CLEAR A WORD
- ISZ CCNT /DONE YET?
- JMP .-2 /NO, DO ANOTHER
- DCA CHKFLG /ENABLE CHECKSUMMING
- JMP I CLRCHKSUM /RETURN
-
- INVCHKS,.-. /CHECKSUM INVERSION ROUTINE
- JMS CHKSETUP /SETUP
- STL /FORCE INITIAL CARRY
- COMLUP, TAD I XR1 /GET A WORD
- CMA /INVERT IT
- SZL /SKIP IF NO CARRY
- CLL IAC /ELSE ADD ONE AND CLEAR CARRY FOR NEXT TIME
- DCA I XR2 /STORE BACK
- ISZ CCNT /DONE ALL YET?
- JMP COMLUP /NO, KEEP GOING
- JMP I INVCHKSUM /YES, RETURN
-
- CHKSETU,.-. /CHECKSUM SETUP ROUTINE
- TAD (CHKSUM-1) /POINT TO
- DCA XR1 /CHECKSUM AREA
- TAD (CHKSUM-1) /POINT TO
- DCA XR2 /CHECKSUM AREA
- TAD [-5] /SETUP THE
- DCA CCNT /CHECKSUM COUNT
- JMP I CHKSETUP /RETURN
- / FILE DATE ROUTINE.
-
- FDMESSA,.-. /PUT FILE DATE IN MESSAGE ROUTINE
- TAD FDATE /GET INPUT FILE'S DATE
- SNA CLA /SKIP IF ANY
- JMP I FDMESSAGE /RETURN IF NONE
- JMS I [SCRIBE] /PRINT OUT THE
- DATMSG /DATE BLURB
- TAD FDATE /GET IT BACK
- JMS PRDATE /PRINT THE DATE
- JMS I [SCRIBE] /PRINT THE
- EMSG /END MESSAGE
- JMP I FDMESSAGE /RETURN
-
- TDMESSA,.-. /PUT TODAY'S DATE IN MESSAGE ROUTINE
- JMS I [SCRIBE] /OUTPUT THE
- REMMSG /OPENING REMARKS
- CDF TBLFLD /GOTO TABLE FIELD
- TAD I (DATWRD) /GET DATE WORD
- CDF PRGFLD /BACK TO OUR FIELD
- SNA /SKIP IF THERE
- JMP NOTDATE /JUMP IF NOT
- DCA TDATE /SAVE TODAY'S DATE
- JMS I [SCRIBE] /OUTPUT THE
- ONMSG /BRIDGING MESSAGE
- TAD TDATE /GET TODAY'S DATE
- JMS PRDATE /PRINT TODAY'S DATE
- NOTDATE,JMS I [SCRIBE] /OUTPUT THE
- EMSG /END MESSAGE
- JMP I TDMESSAGE /RETURN
- PRDATE, .-. /DATE PRINT ROUTINE
- DCA PRTEMP /SAVE PASSED VALUE
- TAD PRTEMP /GET IT BACK
- RTR;RAR /MOVE DOWN
- AND [37] /JUST DAY BITS
- JMS I (DEC2) /PRINT AS TWO DIGITS
- TAD PRTEMP /GET DATE AGAIN
- AND [7400] /JUST MONTH BITS
- CLL RTL;RTL;RTL /MOVE DOWN
- TAD (MONLST-2-1) /POINT TO PROPER ELEMENT
- DCA XR1 /STASH THE POINTER
- TAD I XR1 /GET FIRST PAIR
- DCA I (MMSG+1) /STORE IN MESSAGE
- TAD I XR1 /GET SECOND PAIR
- DCA I (MMSG+2) /STORE IN MESSAGE
- JMS I [SCRIBE] /OUTPUT THE
- MMSG /MONTH MESSAGE
- TAD PRTEMP /GET DATE AGAIN
- AND [7] /JUST YEAR BITS
- DCA TEMP /SAVE IT
- CDF TBLFLD /GOTO TABLE FIELD
- TAD I (DATWRD) /GET CURRENT DATE WORD
- CDF PRGFLD /BACK TO OUR FIELD
- AND [7] /JUST YEAR BITS
- CIA /INVERT FOR TEST
- TAD TEMP /COMPARE TO DESIRED YEAR
- SMA SZA CLA /SKIP IF THEY MATCH OR ARE EARLIER
- TAD (-10) /ELSE BACKUP A GROUP
- TAD TEMP /ADD TO YEAR
- DCA TEMP /STORE BACK
- TAD I (DATEXT) /GET EXTENSION WORD
- AND [600] /JUST EXTENSION BITS
- CLL RTR;RTR /MAKE IT GROUP COUNT
- TAD TEMP /ADD ON RELATIVE YEAR
- TAD (106) /MAKE IT ABSOLUTE YEAR (70-99)
- JMS I (DEC2) /PRINT AS TWO DIGITS
- JMP I PRDATE /RETURN
-
- PAGE
- DEC2, .-. /PRINT TWO DIGITS ROUTINE
- JMS DIVIDE /DIVIDE
- 12 /BY 10
- TAD ["0&177] /MAKE IT ASCII
- JMS I [DOBYTE] /OUTPUT IT
- TAD REM /GET SECOND DIGIT
- TAD ["0&177] /MAKE IT ASCII
- JMS I [DOBYTE] /OUTPUT IT
- JMP I DEC2 /RETURN
-
- / DIVIDE ROUTINE.
-
- DIVIDE, .-. /DIVIDE ROUTINE
- DCA REM /SAVE IN REMAINDER
- DCA QUO /CLEAR QUOTIENT
- TAD REM /GET IT BACK
- STL CIA /INVERT
- SKP /DON'T FIRST TIME
- DVLOOP, ISZ QUO /BUMP UP QUOTIENT
- TAD I DIVIDE /ADD ON ARGUMENT
- SNA SZL /UNDERFLOW?
- JMP DVLOOP /NO, KEEP GOING
- CIA /YES, INVERT IT BACK
- TAD I DIVIDE /RESTORE LOST VALUE
- DCA REM /SAVE AS REMAINDER
- TAD QUO /GET THE QUOTIENT
- ISZ DIVIDE /BUMP PAST ARGUMENT
- JMP I DIVIDE /RETURN
-
- INDATE, .-. /GET INPUT FILE'S DATE WORD
- CDF TBLFLD /GOTO TABLE FIELD
- TAD IMSW /GET IMAGE-MODE SWITCH
- SNA CLA /SKIP IF SET
- JMP NOIMG /JUMP IF NOT
- TAD I (DATWRD) /USE TODAY'S DATE
- JMP NOAIW /CONTINUE THERE
-
- NOIMG, TAD I (AIWCNT) /GET AIW COUNT
- SNA /SKIP IF ANY
- JMP NOAIW /JUMP IF NOT
- TAD I [AIWXR] /GET ENTRY POINTER
- DCA TEMP /STASH FIRST AIW POINTER
- TAD I TEMP /GET FIRST AIW
- NOAIW, DCA FDATE /SAVE AS FILE'S DATE
- CDF PRGFLD /BACK TO OUR FIELD
- JMP I INDATE /RETURN
- / INPUT FILENAME MOVE ROUTINE; USES DEFAULT EXTENSION IF NONE PROVIDED BY USER.
-
- MIFNAME,.-. /MOVE INPUT FILENAME ROUTINE
- TAD I (INFILE+1) /GET FIRST INPUT FILENAME WORD
- SNA /SKIP IF SOMETHING THERE
- JMP IMTEST /JUMP IF NOT
- IFNAMOK,DCA IFNAME /STASH IT
- TAD I (INFILE+2) /GET SECOND INPUT FILENAME WORD
- DCA IFNAME+1 /STASH IT
- TAD I (INFILE+3) /GET THIRD INPUT FILENAME WORD
- DCA IFNAME+2 /STASH IT
- TAD I [INFILE+4] /GET FOURTH INPUT FILENAME WORD
- SNA /SKIP IF SOMETHING THERE
- TAD ("S^100+"V-300) /ELSE USE DEFAULT EXTENSION VALUE
- DCA IFNAME+3 /STASH IT EITHER WAY
- JMP I MIFNAME /RETURN
-
- / TEST IF IMAGE-MODE IS SET. ASSUME /1 AND /2 ARE NOT SET.
-
- IMTEST, TAD I (SWAL) /GET /A-/L SWITCHES
- AND (10) /JUST /I BIT
- SZA CLA /SKIP IF NOT SET
- TAD I [EQUWRD] /GET EQUALS PARAMETER
- SNA /SKIP IF SOMETHING THERE
- JMP I (INERR) /ELSE COMPLAIN
- CIA /INVERT IT
- DCA INLEN /USE AS INPUT RECORD COUNT
- DCA INRECORD /START AT THE BEGINNING OF THE DEVICE
- ISZ IMSW /INDICATE IMAGE-MODE SET
-
- / TEST IF /1 OR /2 IS SET.
-
- TAD I [SWY9] /GET /Y-/9 SWITCHES
- AND [600] /JUST /1, /2 SWITCHES
- SNA /SKIP IF EITHER SET
- JMP IFNAMOK /JUMP IF NEITHER SET
-
- / TEST IF /1 IS SET. IF NOT, /2 MUST BE SET.
-
- AND [400] /JUST /1 SWITCH
- SNA CLA /SKIP IF /1 SET
- JMP IM2 /JUMP IF /2 SET
-
- / FOR A FIRST HALF, USE THE ROUNDED-DOWN FIRST HALF LENGTH. THE DATA STARTS AT
- / RECORD ZERO (ALREADY SET).
-
- TAD I [EQUWRD] /GET EQUALS PARAMETER
- CLL RAR /%2
- IM2ENTR,CIA /INVERT IT
- DCA INLEN /SET COUNT FOR HALF OF THE DEVICE
- JMP IFNAMOK /KEEP GOING
- / FOR A SECOND HALF, THE DATA STARTS AT THE HALFWAY POINT (ROUNDED DOWN).
-
- IM2, TAD I [EQUWRD] /GET EQUALS PARAMETER
- CLL RAR /%2
- DCA INRECORD /SETUP STARTING RECORD
-
- / FOR A SECOND HALF, THE COUNT IS THE ORIGINAL AMOUNT MINUS THE COUNT FOR THE
- / FIRST HALF.
-
- TAD I [EQUWRD] /GET EQUALS PARAMETER
- CLL RAR /%2
- CIA /INVERT IT
- TAD I [EQUWRD] /SUBTRACT FROM EQUALS PARAMETER
- JMP IM2ENTRY /CONTINUE THERE
-
- CHKBND, .-. /CHECK IF ON GOOD OUTPUT BOUNDARY ROUTINE
- TAD OBOUND /GET BOUNDARY COUNTER
- TAD (5) /COMPARE TO BEGINNING VALUE
- SNA CLA /SKIP IF NOT AT BEGINNING
- ISZ CHKBND /SET SKIP RETURN IF AT BEGINNING
- JMP I CHKBND /RETURN EITHER WAY
-
- OCTOUT, .-. /OCTAL OUTPUT ROUTINE
- DCA OCTEMP /SAVE IT
- TAD (-4) /SETUP THE
- DCA OCTCNT /DIGIT COUNTER
- OCTLUP, TAD OCTEMP /GET THE VALUE
- RTL;RAL /MOVE UP A DIGIT
- DCA OCTEMP /STORE BACK
- TAD OCTEMP /GET IT AGAIN
- RAL /PUT INTO CORRECT BITS
- AND [7] /JUST ONE DIGIT
- TAD ["0&177] /MAKE IT ASCII
- JMS I [DOBYTE] /OUTPUT IT
- ISZ OCTCNT /DONE ENOUGH?
- JMP OCTLUP /NO, GO BACK FOR MORE
- JMP I OCTOUT /YES, RETURN TO CALLER
-
- PAGE
- / FILE TEXT MESSAGES.
-
- DATMSG, TEXT "(^REMARK F^ILE ^D^ATE: "
- EMSG, TEXT ")%^"
- ENDMSG, TEXT ">%(^END ^"
- EOFMSG, TEXT "(^REMARK E^ND OF ^F^ILE)%"
- FILMSG, TEXT "(^FILE "
- IFMSG, TEXT "^B^LOCK-^I^MAGE-^F^ILE =^"
- MMSG, TEXT "-^D^EC-19"
- ONMSG, TEXT ": ^"
- PT1MSG, TEXT " ^F^IRST ^H^ALF"
- PT2MSG, TEXT " ^S^ECOND ^H^ALF^"
- REMMSG, TEXT "(^REMARK PDP-8/DEC^MATE ^E^NCODING ^P^ROGRAM ^V^ERSION ^"
- "0+VERSION^100+".-200; "0+REVISION^100+" -200
- TEXT " C^HARLES ^L^ASNER)%"
- TEXT "(^REMARK I^MAGE ^F^ILE ^C^REATED BY ^PDP^-8"
-
- / MONTH TEXT TABLE.
-
- MONLST, TEXT "J^AN" /JANUARY
- TEXT "F^EB" /FEBRUARY
- TEXT "M^AR" /MARCH
- TEXT "A^PR" /APRIL
- TEXT "M^AY" /MAY
- TEXT "J^UN" /JUNE
- TEXT "J^UL" /JULY
- TEXT "A^UG" /AUGUST
- TEXT "S^EP" /SEPTEMBER
- TEXT "O^CT" /OCTOBER
- TEXT "N^OV" /NOVEMBER
- TEXT "D^EC" /DECEMBER
- $ /THAT'S ALL FOLK!
-